home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic3 / pro5 / weekday.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1990-04-12  |  1.9 KB  |  61 lines
  1. 100  REM DAY OF THE WEEK
  2. 105  WIDTH 80
  3. 110  REM IBM BASIC
  4. 120  GOTO 170
  5. 130  PRINT STRING$(80,45):RETURN
  6. 140  CLS:FOR X=1 TO 10:PRINT:NEXT X:RETURN
  7. 150  PRINT:INPUT "Press >RETURN< ",R$:RETURN
  8. 160  GOSUB 140:GOSUB 130:PRINT TAB(38)"End.":GOSUB 130:RUN"files."
  9. 170  GOSUB 140:GOSUB 130:PRINT TAB(10)"This program determines the day of the week":PRINT
  10. 180  PRINT TAB(10)"for any date after 1584, the start of the":PRINT
  11. 190  PRINT TAB(10)"Gregorian Calendar.":GOSUB 130:GOSUB 150:GOSUB 140
  12. 200  INPUT "Month (one or two digits)     ",M:PRINT
  13. 210  INPUT "Day   (one or two digits)     ",D:PRINT
  14. 220  INPUT "Year (four digits)            ",Y:GOSUB 130
  15. 230  IF M=1 THEN M$="JANUARY" 
  16. 240  IF M=2 THEN M$="FEBRUARY" 
  17. 250  IF M=3 THEN M$="MARCH"
  18. 260  IF M=4 THEN M$="APRIL" 
  19. 270  IF M=5 THEN M$="MAY" 
  20. 280  IF M=6 THEN M$="JUNE"
  21. 290  IF M=7 THEN M$="JULY" 
  22. 300  IF M=8 THEN M$="AUGUST" 
  23. 310  IF M=9 THEN M$="SEPTEMBER"
  24. 320  IF M=10 THEN M$="OCTOBER" 
  25. 330  IF M=11 THEN M$="NOVEMBER" 
  26. 340  IF M=12 THEN M$="DECEMBER"
  27. 350  ON M GOTO 360,370,380,390,400,410,420,430,440,450,460,470
  28. 360  E=D:GOTO 490
  29. 370  E=D+31:GOTO 490
  30. 380  E=D+59:GOTO 490
  31. 390  E=D+90:GOTO 480
  32. 400  E=D+120:GOTO 480
  33. 410  E=D+151:GOTO 480
  34. 420  E=D+181:GOTO 480
  35. 430  E=D+212:GOTO 480
  36. 440  E=D+243:GOTO 480
  37. 450  E=D+273:GOTO 480
  38. 460  E=D+304:GOTO 480
  39. 470  E=D+334
  40. 480  XX=Y-1584:XX=XX/4:XXX=INT(XX):IF XX=XXX THEN E=E+1
  41. 490  Z=(Y-1584)/Y:A=INT(Z):Z=Z-A:IF Z=0 THEN 500 ELSE 510
  42. 500  E=E+1
  43. 510  B=(Y-1)/4:B=INT(B):C=(Y-1)/100:C=INT(C):F=(Y-1)/400:F=INT(F)
  44. 520  G=E+Y+B-C+F:H=G/7:I=INT(H):I=H-I:I=I*7:GOSUB 140:GOSUB 130
  45. 530  IF I<1 AND I>0.5 THEN 600
  46. 540  IF I<2 AND I>1.5 THEN 610
  47. 550  IF I<3 AND I>2.5 THEN 620
  48. 560  IF I<4.5 AND I>4 THEN 630
  49. 570  IF I<5.5 AND I>5 THEN 640
  50. 580  IF I<6.5 AND I>6 THEN 650
  51. 590  IF I=0 THEN 660
  52. 600  PRINT TAB(28)M$;" ";D;", ";Y;" is a Sunday":GOSUB 130:GOSUB 150:GOTO 670
  53. 610  PRINT TAB(28)M$;" ";D;", ";Y;" is a Monday":GOSUB 130:GOSUB 150:GOTO 670
  54. 620  PRINT TAB(28)M$;" ";D;", ";Y;" is a Tuesday":GOSUB 130:GOSUB 150:GOTO 670
  55. 630  PRINT TAB(28)M$;" ";D;", ";Y;" is a Wednesday":GOSUB 130:GOSUB 150:GOTO 670
  56. 640  PRINT TAB(28)M$;" ";D;", ";Y;" is a Thursday":GOSUB 130:GOSUB 150:GOTO 670
  57. 650  PRINT TAB(28)M$;" ";D;", ";Y;" is a Friday":GOSUB 130:GOSUB 150:GOTO 670
  58. 660  PRINT TAB(28)M$;" ";D;", ";Y;" is a Saturday":GOSUB 130:GOSUB 150
  59. 670  GOSUB 140:INPUT "Do you want another date? (Y/N)  ",YY$
  60. 680  IF YY$="N" OR YY$="n" THEN 160 ELSE M$=" ":GOSUB 140:GOTO 200
  61.